home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / tsfaqp35.zip / FAQPAS4.TXT < prev    next >
Internet Message Format  |  1996-11-09  |  51KB
  1. From ts@uwasa.fi Sat Nov 9 00:00:00 1996
  2. Subject: FAQPAS4.TXT contents
  3.  
  4.                                Copyright (c) 1993-1996 by Timo Salmi
  5.                                                  All rights reserved
  6.  
  7. FAQPAS4.TXT The fourth set of frequently (and not so frequently)
  8. asked Turbo Pascal questions with Timo's answers. The items are in
  9. no particular order.
  10.  
  11. You are free to quote brief passages from this file provided you
  12. clearly indicate the source with a proper acknowledgment.
  13.  
  14. Comments and corrections are solicited. But if you wish to have
  15. individual Turbo Pascal consultation, please post your questions to
  16. a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
  17. is much more efficient than asking me by email. I'd like to help,
  18. but I am very pressed for time. I prefer to pick the questions I
  19. answer from the Usenet news. Thus I can answer publicly at one go if
  20. I happen to have an answer. Besides, newsgroups have a number of
  21. readers who might know a better or an alternative answer. Don't be
  22. discouraged, though, if you get a reply like this from me. I am
  23. always glad to hear from fellow Turbo Pascal users.
  24.  
  25. ....................................................................
  26. Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
  27. Moderating at ftp:// & http://garbo.uwasa.fi archives  193.166.120.5
  28. Department of Accounting and Business Finance  ; University of Vaasa
  29. ts@uwasa.fi http://uwasa.fi/~ts BBS 961-3170972; FIN-65101,  Finland
  30.  
  31. --------------------------------------------------------------------
  32. 76) What are the current Pascal newsgroups on the Usenet news?
  33. 77) How do I detect the CapsLock status, how do I turn it on/off?
  34. 78) How do I detect if the F11 or F12 key has been pressed?
  35. 79) How do I extract (parse) substrings from an input string?
  36. 80) How do I find out the size of any kind of a file?
  37. 81) How do I format graphics output like in textmode writeln?
  38. 82) How do I detect if more than one standard key is pressed down?
  39. 83) How can I read a disk's Volume Serial Number?
  40. 84) How can I disable and then enable the keyboard in my TP program?
  41. 85) How do I get the character device name of the (first) CD-ROM?
  42. 86) How do I eject a CD-ROM using a Turbo Pascal program?
  43. 87) How do I find out if the ANSI.SYS driver has been loaded?
  44. 88) Where do I find Turbo Pascal tutorials and/or good textbooks?
  45. 89) How do I make an executable of my Turbo Pascal source program?
  46. 90) How can I quickly read the last byte of a file?
  47. 91) Is 2000 a leap year? What is the leap year algorithm?
  48. 92) Does anybody have a program that gives the week number?
  49. 93) How can I use OutText to write numbers in the graphics mode?
  50. 94) How can I redirect output to file if I use the Crt unit?
  51. 95) How to write a function to return true if I am in graphics mode?
  52. 96) My graph.tpu got corrupted. Someone please email me a new copy.
  53. 97) How can I avoid run-time errors in numeric input using readln?
  54. 98) How can I limit the user's readln input to e.g. 3 characters?
  55. 99) Can you tell a beginner how to delete files with Turbo Pascal?
  56. 100) Could you please explain shl and shr operators to a beginner?
  57. --------------------------------------------------------------------
  58.  
  59. From ts@uwasa.fi Sat Nov 9 00:01:16 1996
  60. Subject: Usenet Pascal newsgroups
  61.  
  62. 76. *****
  63.  
  64.  Q: What are the current Pascal newsgroups on the Usenet news?
  65.  
  66.  A: The following new Pascal newsgroups were created June 12, 1995
  67. to replace the old comp.lang.pascal. The new Delphi newsgroups were
  68. first created around July 10, 1995. Further Delphi newsgroups were
  69. added in April 1996.
  70.  
  71. A special note about Delphi postings. Please use the delphi
  72. newsgroups for the Delphi related postings. In particular, the
  73. newsgroup comp.lang.pascal.borland is _NOT_ for Delphi related
  74. subjects!
  75.  
  76. A second special note. Please avoid crossposting between the
  77. newsgroups. In particular do not crosspost between the old and the
  78. new newsgroups. It slows the transition to the new system. (This
  79. automatic posting breaches the general non-crossposting tenet only
  80. because it is relevant information about the arrangements of all the
  81. newsgroups involved.)
  82.  
  83. CURRENT:
  84.  comp.lang.pascal.ansi-iso Pascal according to ANSI and ISO standards.
  85.  comp.lang.pascal.borland  Borland's Pascal incl. Turbo Pascal (not Delphi!)
  86.  comp.lang.pascal.mac      Macintosh based Pascals.
  87.  comp.lang.pascal.misc     Pascal in general and ungrouped Pascals.
  88.  
  89.  comp.lang.pascal.delphi.advocacy Contentious issues related to Delphi.
  90.  comp.lang.pascal.delphi.announce Delphi related announcements. (Moderated)
  91.  comp.lang.pascal.delphi.components.misc General component issues.
  92.  comp.lang.pascal.delphi.components.usage Using pre-written components.
  93.  comp.lang.pascal.delphi.components.writing Writing Delphi components.
  94.  comp.lang.pascal.delphi.databases Database aspects of Borland Delphi.
  95.  comp.lang.pascal.delphi.misc General issues with Borland Delphi.
  96.  comp.sources.delphi Delphi and ObjectPascal source code. (Moderated)
  97.  
  98. RELATED of potential interest:
  99. comp.os.msdos.programmer.turbovision Borland's text application libraries
  100.  
  101. OLD:  Please cease using!
  102.  comp.lang.pascal                     Discussion about Pascal.
  103.  comp.lang.pascal.delphi.components   Writing components in Borland Delphi.
  104.  
  105. For more information about the Pascal newsgroups please see
  106.  
  107.  52703 Jun 14 1995 ftp://garbo.uwasa.fi/pc/doc-net/pasgroup.zip
  108.  pasgroup.zip Information about the comp.lang.pascal.* newsgroups
  109.  
  110. If your site is not getting the new Pascal newsgroups, please
  111. contact your own site's newsmaster about the situation.
  112. --------------------------------------------------------------------
  113.  
  114. From ts@uwasa.fi Sat Nov 9 00:01:17 1996
  115. Subject: Capslock status and toggling
  116.  
  117. 77. *****
  118.  Q: How do I detect the CapsLock status, how do I turn it on/off?
  119.  
  120.  A: Here are the relevant Turbo Pascal routines in answer to these
  121. questions.
  122.   {}
  123.   Uses Dos;  { The Dos unit is needed }
  124.   {}
  125.   (* Is CapsLock on *)
  126.   function CAPSONFN : boolean;
  127.   var regs      : registers;
  128.       KeyStatus : byte;
  129.   begin
  130.     FillChar (regs, SizeOf(regs), 0);
  131.     regs.ax := $0200;      { Get shift flags }
  132.     Intr ($16, regs);      { The keyboard interrupt }
  133.     KeyStatus := regs.al;  { AL = shift status bits }
  134.     if (KeyStatus and $40) > 0 then         { bit 6 }
  135.       capsonfn := true
  136.     else
  137.       capsonfn := false;
  138.   end;  (* capsonfn *)
  139.   {}
  140.   (* Set CapsLock. Use true to turn on, false to turn off *)
  141.   procedure CAPS (TurnOn : boolean);
  142.   var keyboardStatus : byte absolute $0040:$0017;
  143.       regs           : registers;
  144.   begin
  145.     if TurnOn then
  146.        keyboardStatus := keyboardStatus or $40
  147.      else
  148.        keyboardStatus := keyboardStatus and $BF;
  149.     { Interrrupt "check for keystroke" to ensure the LED status }
  150.     FillChar (regs, SizeOf(regs), 0);
  151.     regs.ah := $01;
  152.     Intr ($16, regs);
  153.   end;  (* caps *)
  154.   {}
  155. As you see, CapsLock is indicated by bit 6. The other toggles can be
  156. handled in an equivalent way using this information about the memory
  157. location Mem[$0040:$0017]:
  158.   ScrollLock = bit 4      $10  $EF
  159.   NumLock    = bit 5      $20  $DF
  160.   CapsLock   = bit 6      $40  $BF
  161. --------------------------------------------------------------------
  162.  
  163. From ts@uwasa.fi Sat Nov 9 00:01:18 1996
  164. Subject: Detecting F11 and F12
  165.  
  166. 78. *****
  167.  Q: How do I detect if the F11 or F12 key has been pressed?
  168.  
  169.  A: Here is a sample program
  170.   uses Dos;
  171.   (* Enhanced keyboard ReadKey, no Crt unit needed. Detects also F11
  172.      and F12, and distinguishes between the numeric keypad and the
  173.      gray keys. Lower part of the word returns the first scan code,
  174.      the higher part the second *)
  175.   function RDENKEFN : word;
  176.   var regs     : registers;
  177.       keyboard : byte absolute $40:$96;
  178.   begin
  179.     rdenkefn := 0;
  180.     if ((keyboard shr 4) and 1) = 0 then exit;
  181.     FillChar (regs, SizeOf(regs), 0);
  182.     regs.ah := $10;
  183.     Intr ($16, regs);
  184.     rdenkefn := regs.ax;
  185.   end;  (* rdenkefn *)
  186.   {}
  187.   procedure TEST;
  188.   var key : word;
  189.   begin
  190.     while Lo(key) <> 27 do  { esc exits }
  191.       begin
  192.         key := RDENKEFN;
  193.         if (Lo(key) = 0) and (Hi(key) = 133) then
  194.           writeln ('F11 was pressed');
  195.         if (Lo(key) = 0) and (Hi(key) = 134) then
  196.           writeln ('F12 was pressed');
  197.       end;
  198.   end;
  199.   {}
  200.   begin TEST; end.
  201. --------------------------------------------------------------------
  202.  
  203. From ts@uwasa.fi Sat Nov 9 00:01:19 1996
  204. Subject: Substrings from a string
  205.  
  206. 79. *****
  207.  Q: How do I extract (parse) substrings from an input string?
  208.  
  209.  A: Carefully study these two routines which I have included in
  210.  23480 Apr 21 1996 ftp://garbo.uwasa.fi/pc/research/simirr11.zip
  211.  simirr11.zip Deriving IRR from ARR: A Simulation Testbench, TS+IV
  212. They use space (and anything in ascii below it) as the separator.
  213. Change the while tests if you wish to have a different set of
  214. separators.
  215.   (* Number of substrings in a string *)
  216.   function PARSENFN (sj : string) : integer;
  217.   var i, n, p : integer;
  218.   begin
  219.     p := Length(sj);
  220.     n := 0;
  221.     i := 1;
  222.     repeat
  223.       while (sj[i] <= #32) and (i <= p) do Inc(i);
  224.       if i > p then begin parsenfn := n; exit; end;
  225.       while (sj[i] > #32) and (i <= p) do Inc(i);
  226.       Inc(n);
  227.       if i > p then begin parsenfn := n; exit; end;
  228.     until false;
  229.   end;  (* parsenfn *)
  230.   {}
  231.   (* Get substrings from a string *)
  232.   function PARSERFN (sj : string; PartNumber : integer) : string;
  233.   var i, j, n, p : integer;
  234.       stash      : string;
  235.   begin
  236.     if (PartNumber < 1) or (PartNumber > PARSENFN(sj)) then
  237.       begin PARSERFN := ''; exit; end;
  238.     p := Length(sj);
  239.     n := 0;
  240.     i := 1;
  241.     repeat
  242.       while (sj[i] <= #32) and (i <= p) do Inc(i);
  243.       Inc(n);
  244.       if n = PartNumber then
  245.         begin
  246.           j := 0;
  247.           while (sj[i] > #32) and (i <= p) do
  248.             begin
  249.               Inc(j);
  250.               stash[0] := chr(j);
  251.               stash[j] := sj[i];
  252.               Inc(i);
  253.             end;
  254.           PARSERFN := stash;
  255.           exit;
  256.         end
  257.        else
  258.          while (sj[i] > #32) and (i <= p) do Inc(i);
  259.     until false;
  260.   end;  (* parserfn *)
  261.   {}
  262.   {... A separate, but useful function from the same package ...}
  263.   (* Delete trailing white spaces etc rubble from a string *)
  264.   function TRAILFN (sj : string) : string;
  265.   var i : byte;
  266.   begin
  267.     i := Length (sj);
  268.     while (i > 0) and (sj[i] <= #32) do i := i - 1;
  269.     sj[0] := chr(i); trailfn := sj;
  270.   end;  (* trailfn *)
  271.   {}
  272.   {... Another separate, but useful function from the same package ...}
  273.   (* Delete leading white spaces etc subble from a string *)
  274.   function LEADFN (sj : string) : string;
  275.   var i, p : byte;
  276.   begin
  277.     p := Length (sj); i := 1;
  278.     while (i <= p) and (sj[i] <= #32) do i := i + 1;
  279.     leadfn := Copy (sj, i, p-i+1);
  280.   end;  (* leadfn *)
  281. --------------------------------------------------------------------
  282.  
  283. From ts@uwasa.fi Sat Nov 9 00:01:20 1996
  284. Subject: Size of a file
  285.  
  286. 80. *****
  287.  Q: How do I find out the size of any kind of a file?
  288.  
  289.  A1: Well, to begin with the FileSize keyword and an example code
  290. are given in the manual (and help function of later TP versions) so
  291. those, as usual, are the first places to look at. But the example
  292. solution can be somewhat improved, and there is also an alternative
  293. solution. The FSIZEFN should never be applied on an open file.
  294.   function FSIZEFN (filename : string) : longint;
  295.   var fle    : file of byte;  { declare as a file of byte }
  296.       fmSave : byte;
  297.   begin
  298.     fmSave := FileMode;       { save the current filemode }
  299.     FileMode := 0;            { to handle also read-only files }
  300.     assign (fle, filename);
  301.     {$I-} reset (fle); {$I+}  { to do your own error detection }
  302.     if IOResult <> 0 then begin
  303.       fsizefn := -1; FileMode := fmSave; exit;
  304.     end;
  305.     fsizefn := FileSize(fle);
  306.     close (fle);
  307.     FileMode := fmSave;       { restore the original filemode }
  308.   end; (* fsizefn *)
  309.  
  310.  A2: The second, general alternative is
  311.   uses Dos;
  312.   function FSIZE2FN (FileName : string) : longint;
  313.   var FileInfo : SearchRec;   { SearchRec is declared in the Dos unit }
  314.   begin
  315.     fsize2fn := -1;           { return -1 if anything goes wrong }
  316.     FindFirst (filename, AnyFile, FileInfo);
  317.     if DosError <> 0 then exit;
  318.     if (FileInfo.Attr and VolumeId = 0) and
  319.        (FileInfo.Attr and Directory = 0) then
  320.          fsize2fn := FileInfo.Size;
  321.   end;  (* fsize2fn *)
  322.  
  323.  A3: The third alternative is due to a Usenet posting by Wayne
  324. Hoxsie (hoxsiew@crl.com). This alternative is an instructive example
  325. of using file handles.
  326.   uses dos;
  327.   var f : file;
  328.   {}
  329.   function filelength (var f : file) : longint;
  330.   var
  331.     handle : ^word;
  332.     regs : registers;
  333.   begin
  334.     handle := @f;
  335.     fillchar (regs, SizeOf(regs), 0);   { just in case }
  336.     regs.ax := $4202;
  337.     regs.bx := handle^;
  338.     regs.cx := 0;
  339.     regs.dx := 0;
  340.     msdos(regs);
  341.     filelength := (longint(regs.dx) SHL 16)+regs.ax;
  342.   end;
  343.   {}
  344.   begin
  345.     assign(f,paramstr(1));
  346.     filemode := 0;  { read-only files too }
  347.     reset(f);
  348.     writeln(filelength(f));
  349.     close(f);
  350.   end.
  351. --------------------------------------------------------------------
  352.  
  353. From ts@uwasa.fi Sat Nov 9 00:01:21 1996
  354. Subject: Formatting graphics output
  355.  
  356. 81. *****
  357.  Q: How do I format graphics output like in textmode writeln?
  358.  
  359.  A: In the graphics mode the positioned text output procedure is
  360. OutTextXY (X ,Y : integer; TextString : string); It does not have
  361. the same output formatting capabilities as the write procedure. It
  362. only accepts the one TextString. Therefore all the output formatting
  363. must be done previously on the string. The Str procedure has such
  364. capabilities. The example below gives the rudiments.
  365.   uses Crt, Graph;
  366.   var grDriver : integer;
  367.       grMode   : integer;
  368.       ErrCode  : integer;
  369.       s, s1    : string;
  370.       v1       : real;
  371.   begin
  372.     grDriver := Detect;
  373.     InitGraph (grDriver, grMode, ' ');
  374.     ErrCode := GraphResult;
  375.     if ErrCode <> grOk then begin
  376.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  377.     ClearDevice;
  378.     {}
  379.     { Writing text in the graphics mode }
  380.     { Set the drawing color }
  381.     SetColor (Yellow);
  382.     { Set the current background color }
  383.     SetBkColor (Black);
  384.     { Set style for text output in graphics mode }
  385.     SetTextStyle (DefaultFont, HorizDir, 2);
  386.     { Preprocess the text }
  387.     v1 := 2.345;
  388.     Str (v1 : 10:2, s1);
  389.     s := 'The first value is' + s1 + '.';
  390.     { Output the text }
  391.     OutTextXY (100, 30, s);
  392.     OutTextXY (100, 50, 'Press any key');
  393.     {}
  394.     repeat until KeyPressed;
  395.     {}
  396.     RestoreCrtMode;
  397.     writeln ('That''s all folks');
  398.     CloseGraph;
  399.   end.
  400. Besides not having the same output formatting capabilities OutTextXY
  401. and OutText procedures do not scroll the screen. If you wish to
  402. achieve such an effect, you will have to code it yourself step by
  403. step. You can see the effect in
  404.  111673 Oct 8 1993 ftp://garbo.uwasa.fi/pc/ts/tsdemo16.zip
  405.  tsdemo16.zip Assorted graphics demonstrations of functions etc
  406. Coding the scrolling is a straight-forward but a laborious task.
  407. Hence it is beyond this FAQ. The outline, however, is that you must
  408. keep track where on the screen you are. When you come to the bottom
  409. of your window you have to move the above region upwards before you
  410. output new text. You can move graphics regions using the ImageSize,
  411. GetImage and PutImage procedures.
  412.   As for readln-type input in a graphics mode, that is a complicated
  413. issue. You will have to build the input routine reading a character
  414. at a time with ReadKey. The rudiments of using ReadKey are shown in
  415. the first question of FAQPAS.TXT. The demo, referred to a few lines
  416. back, will show the effect.
  417. --------------------------------------------------------------------
  418.  
  419. From ts@uwasa.fi Sat Nov 9 00:01:22 1996
  420. Subject: Reading more than one key
  421.  
  422. 82. *****
  423.  Q: How do I detect if more than one standard key is pressed down?
  424.  
  425.  A: The example code below relies very heavily on a Usenet posting
  426. by Lou Duchez ljduchez@en.com who wishes to acknowledge Bill Seiler
  427. for the handling of ports. The KeyNrDown and TEST routines are by
  428. myself. Besides being a demonstration the TEST procedure can be used
  429. to get the scan codes of the different keys instead of relying on
  430. external documentation.
  431.   Uses Dos;
  432.   {}
  433.   var keydown: array[0..127] of boolean;   { status array }
  434.       oldkbdint: procedure;       { points to the "normal" keyboard handler }
  435.       port60h, port61h: byte;     { used within the interrupt for storage }
  436.   {}
  437.   { The replacement keyboard handler }
  438.   procedure newkbdint; interrupt;
  439.   begin
  440.     port60h := port[$60];
  441.     keydown[port60h and $7f] := (port60h <= $7f);
  442.     port61h := port[$61];
  443.     port[$61] := port61h or $80;
  444.     port[$61] := port61h;
  445.     port[$20] := $20;
  446.   end;
  447.   {}
  448.   { Get the scancode of the key pressed down, 128 for none }
  449.   function KeyNrDown : byte;
  450.   var i : byte;
  451.   begin
  452.     KeyNrDown := 128;
  453.     for i := 0 to 127 do if KeyDown[i] then KeyNrDown := i;
  454.   end;
  455.   {}
  456.   { Test by displaying the scan codes of the keys pressed }
  457.   procedure TEST;
  458.   var k, k1 : byte;
  459.   begin
  460.     k1 := 128;
  461.     repeat
  462.       k := KeyNrDown;
  463.       if k <> k1 then begin
  464.         write (k, ' ');
  465.         if (k1 = 30) and (k = 31) then writeln ('Pressed A and S ');
  466.         k1 := k;
  467.       end;
  468.     until k = $01; {escape}
  469.   end; {test}
  470.   {}
  471.   begin
  472.     { turn on the replacement keyboard handler }
  473.     fillchar(keydown, 128, #0);  { sets array to all "false" }
  474.     getintvec($09, @oldkbdint);  { record location of old keyboard int }
  475.     setintvec($09, @newkbdint);  { this line installs the new interrupt }
  476.     {}
  477.     TEST;
  478.     {}
  479.     { turn off the replacement keyboard handler }
  480.     setintvec($09, @oldkbdint);
  481.   end.
  482. --------------------------------------------------------------------
  483.  
  484. From ts@uwasa.fi Sat Nov 9 00:01:23 1996
  485. Subject: Volume Serial Number
  486.  
  487. 83. *****
  488.  Q: How can I read a disk's Volume Serial Number?
  489.  
  490.  A: The Volume Serial Number for disks was introduced in MS-DOS
  491. version 4.0. Here is an example code
  492.   uses Dos;
  493.   {}
  494.   (* Convert a longint to a hexadecimal string *)
  495.   function LHEXFN (decimal : longint) : string;
  496.   const hexDigit : array [0..15] of char = '0123456789ABCDEF';
  497.   var i         : byte;
  498.       hexString : string;
  499.   begin
  500.     FillChar (hexString, SizeOf(hexString), ' ');
  501.     hexString[0] := chr(8);
  502.     for i := 0 to 7 do
  503.       hexString[8-i] := HexDigit[(decimal shr (4*i)) and $0F];
  504.     lhexfn := hexString;
  505.   end;  (* lhexfn *)
  506.   {}
  507.   (* Get disk serial number. Requires MS-DOS 4.0+.
  508.      Else, or on an error, returns an empty string.
  509.      The default drive can be pointed to by using '0' *)
  510.   function GETSERFN (drive : char) : string;
  511.   type diskInfoRecordType =
  512.     record
  513.       infoLevel      : word;                   { zero }
  514.       serialNumber   : longint;                { DWORD actually }
  515.       volumeLabel    : array [1..11] of char;  { NO NAME if none present }
  516.       filesystemType : array [1..8] of char;   { FAT12 or FAT16 }
  517.     end;
  518.   var regs     : registers;
  519.       diskInfo : diskInfoRecordType;
  520.       serial   : string;
  521.   begin
  522.     getserfn := '';
  523.     if swap(DosVersion) < $0400 then exit;
  524.     FillChar (regs, SizeOf(regs), 0);
  525.     drive := UpCase (drive);
  526.     if drive <> '0' then if (drive < 'A') or (drive > 'Z') then exit;
  527.     regs.ah := $69;             { Interrrupt 21 function $69 }
  528.     regs.al := $00;             { subfunction: get serial number }
  529.     if drive <> '0' then
  530.       regs.bl := ord(drive) - ord('A') + 1
  531.       else regs.bl := 0;
  532.     regs.ds := Seg(diskInfo);   { the diskInfo address: }
  533.     regs.dx := Ofs(diskInfo);   { its segment and offset }
  534.     Intr ($21, regs);
  535.     if (regs.flags and FCarry) <> 0 then exit;  { CF is set on error }
  536.     serial := LHEXFN (diskInfo.serialNumber);
  537.     getserfn := Copy (serial, 1, 4) + '-' + Copy (serial, 5, 4);
  538.   end;  (* getserfn *)
  539.   {}
  540.   begin
  541.     writeln ('C: ', GETSERFN('C'));
  542.   end.
  543.  
  544.  A2: The second alternative has been modified from a posting by
  545. Robert B. Clark rclark@su1.in.net. I have also utilized INTERRUP.E
  546. from Ralf Brown's listing of interrupt calls
  547.  ftp://garbo.uwasa.fi/pc/programming/inter52b.zip
  548.   {}
  549.   uses Dos;
  550.   function GETSERFN2 (drive : char): longint;
  551.   var ParBlock : array [0..24] of char;  { IOCTL parameter block Table 0785 }
  552.       regs     : registers;
  553.       sernum   : longint;
  554.   begin
  555.     FillChar (ParBlock, SizeOf(ParBlock), 0);
  556.     FillChar (regs, SizeOf(regs), 0);
  557.     regs.ax := $440D;     { IOCTL - generic block device request }
  558.     if drive <> '0' then  { '0' points to the default drive }
  559.       regs.bl := ord(UpCase(drive)) - ord('A') + 1  { drive as byte }
  560.       else regs.bl := 0;
  561.     regs.ch := $08;       { block device IOCTL category code: disk drive }
  562.     regs.cl := $66;       { IOCTL minor code: get volume serial number }
  563.     regs.ds := Seg(ParBlock);   { Parameter block segment address }
  564.     regs.dx := Ofs(ParBlock);   { Parameter block offset }
  565.     MsDos (regs);         { Call interrupt $21 }
  566.     if regs.Flags and FCarry = 0 then
  567.       sernum := word(ord(ParBlock[4]) + ord(ParBlock[5]) shl 8) * 65536 +
  568.                 word (ord(ParBlock[2]) + ord(ParBlock[3]) shl 8)
  569.     else sernum := 0;
  570.     getserfn2 := sernum;
  571.   end;  (* getsetfn2 *)
  572.   {}
  573.   begin
  574.     writeln ('C: ', LHEXFN(GETSERFN2('0')));
  575.   end.
  576.  
  577.  A3: Setting a disk's serial number, instead of just reading it, is
  578. more complicated and will not be covered here. If you need it, the
  579. routine without source code is available (for floppies only for
  580. security reasons) as
  581.   "SETSER Set floppy's serial number (MS-DOS 4.0+)"
  582. in TSUNTK.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
  583.  
  584. --------------------------------------------------------------------
  585.  
  586. From ts@uwasa.fi Sat Nov 9 00:01:24 1996
  587. Subject: Disabling the keyboard
  588.  
  589. 84. *****
  590.  Q: How can I disable and then enable the keyboard in my TP program?
  591.  
  592.  A: Here is the code. A warning! Don't experiment with ports. You
  593. can do real harm to your data and your computer if you do not know
  594. exactly what you are doing.
  595.   uses Dos, Crt;  { Crt only needed because of 'Delay' in the testing }
  596.   var i : byte;   { only needed in the testing }
  597.       NormalKeyboard : procedure;
  598.   {}
  599.   procedure DisableKeyboard; interrupt;
  600.   var port60, port61 : byte;
  601.   begin
  602.     port60 := Port[$60];  { KeyBoard controller data output buffer }
  603.     port61 := Port[$61];  { Keyboard controller port B }
  604.     Port[$61] := Port61 or $80;  { clear keyboard }
  605.     Port[$61] := Port61;
  606.     Port[$20] := $20;     { Programmable Intr. Contr. initialization }
  607.   end;
  608.   {}
  609.   begin
  610.     writeln ('Testing...');
  611.     GetIntVec ($09, @NormalKeyboard);
  612.     SetIntVec ($09, @DisableKeyboard);
  613.     write ('The keyboard is now disabled..');
  614.     for i := 1 to 5 do begin
  615.       Delay (1000);
  616.       write (i:2);
  617.     end; {for}
  618.     writeln;
  619.     SetIntVec ($09, @NormalKeyboard);
  620.     write ('The keyboard is now enabled...');
  621.     for i := 1 to 5 do begin
  622.       Delay (1000);
  623.       write (i:2);
  624.     end; {for}
  625.   end.
  626. --------------------------------------------------------------------
  627.  
  628. From ts@uwasa.fi Sat Nov 9 00:01:25 1996
  629. Subject: CD-ROM device name
  630.  
  631. 85. *****
  632.  Q: How do I get the character device name of the (first) CD-ROM?
  633.  
  634.  A: First the code for a quick and dirty method to find the
  635. character device name
  636.   function MSCDEXFN : string;
  637.   var s : string;
  638.       f : text;
  639.       i : byte;
  640.       fmSave : byte;
  641.   begin
  642.     mscdexfn := '';                  { To indicate not found }
  643.     fmSave := FileMode;              { Store the original file mode }
  644.     FileMode := 0;                   { Also if read-only }
  645.     Assign (f, 'c:\autoexec.bat');   { Browse the AUTOEXEC.BAT }
  646.     {$I-} Reset (f); {$I+}
  647.     if IOResult <> 0 then exit;      { AUTOEXEC.BAT not found }
  648.     while not eof(f) do begin        { Line by line }
  649.       readln (f, s);
  650.       for i := 1 to Length(s) do s[i] := Upcase(s[i]);
  651.       if Pos('MSCDEX', s) > 0 then begin      { Is this the line }
  652.         if Pos ('REM', s) = 1 then continue;  { Skip rem lines }
  653.         Close (f);
  654.         FileMode := fmSave;          { Restore the original mode }
  655.         i := Pos('/D:', s);          { Look for the switch }
  656.         if i = 0 then exit;          { Nah! }
  657.         i := i + 3;                  { Where the name should start }
  658.         if i > Length(s) then exit;  { Nothing there! }
  659.         s := Copy (s, i, 255);       { Rest of the line after /D: }
  660.         mscdexfn := s;
  661.         i := Pos (' ', s);
  662.         if i = 0 then exit;
  663.         mscdexfn := Copy (s, 1, i-1);
  664.         exit;                        { Don't close twice }
  665.       end; {if}
  666.     end; {while}
  667.     Close (f);
  668.     FileMode := fmSave;              { Restore the original mode }
  669.   end; (* mscdexfn *)
  670.  
  671.  A2: There is more general and orthodox solution to finding the
  672. character device name for the (first)m CD-ROM. This was kindly
  673. provided to me by Chris Rankin (rankin@shfax1.shef.ac.uk).
  674.   uses Dos;
  675.   function GetCDROMDevice : string;
  676.   const driver_name_len = 8;
  677.   type
  678.     sig     = array[1..6] of char;
  679.     siglet  = array[1..4] of char;
  680.     signum  = array[1..2] of char;
  681.     drvname = array[1..driver_name_len] of char;
  682.     driverstr = string[driver_name_len];
  683.   type
  684.     PCDROMDriver = ^TCDROMDriver;
  685.     TCDROMDriver = record
  686.                      NextDriver:         PCDROMDriver;
  687.                      DeviceAttr:         word;
  688.                      StrategyEntryPoint: word;
  689.                      INTEntryPoint:      word;
  690.                      DeviceName:         drvname;
  691.                      Reserved:           word;
  692.                      DriveLetter:        byte;
  693.                      Units:              byte;
  694.                    case byte of
  695.                      0: (SigLetters:     siglet;
  696.                          SigNumbers:     signum);
  697.                      1: (Signature:      sig)
  698.                    end;
  699.     TDriveEntry = record
  700.                     SubUnit: byte;
  701.                     Driver:  PCDROMDriver
  702.                   end;
  703.   var
  704.     DeviceList: array[1..26] of TDriveEntry;
  705.     Regs:       registers;
  706.     Name:       driverstr;
  707.   begin
  708.     with Regs do
  709.       begin
  710.         ax := $1500;
  711.         bx := 0;
  712.         intr($2f,Regs);      (* Ask for number of CD-ROM drives. *)
  713.         if bx = 0 then       (* If none, then exit.              *)
  714.           begin
  715.             Name[0] := #0;
  716.             GetCDROMDevice := Name;
  717.             exit
  718.           end;
  719.         ax := $1501;           (* Put information about each CD-ROM *)
  720.         es := seg(DeviceList); (*  into DeviceList[].               *)
  721.         bx := ofs(DeviceList);
  722.         intr($2f,Regs)
  723.       end;  (* Below: Name of first CD-ROM driver *)
  724.     Name := DeviceList[1].Driver^.DeviceName;
  725.     while Name[length(Name)] = ' ' do  (* Strip off trailing blanks.. *)
  726.       dec(Name[0]);
  727.     GetCDROMDevice := Name
  728.   end;
  729. --------------------------------------------------------------------
  730.  
  731. From ts@uwasa.fi Sat Nov 9 00:01:26 1996
  732. Subject: Ejecting CD-ROM
  733.  
  734. 86. *****
  735.  Q: How do I eject a CD-ROM using a Turbo Pascal program?
  736.  
  737.  A: The code for the ejection is given below. Note that it needs the
  738. MSCDEXFN function from the previous FAQ item.
  739.   uses Dos;
  740.   {}
  741.   procedure EJECT (charDev     : string;
  742.                    var ok      : boolean;
  743.                    var errCode : word);
  744.   var regs        : registers;
  745.       cdrom       : file;
  746.       cdCtrlBlock : byte;            { CD-ROM Control Block }
  747.       handle      : ^word;           { Handle referencing CD-ROM driver }
  748.   begin
  749.     Assign (cdrom, charDev);         { Character device for CD-ROM driver }
  750.     {$I-} Reset (cdrom); {$I+}       { Tackle errors yourself }
  751.     if IOresult <> 0 then begin      { Exit if file not found }
  752.       ok := false;
  753.       errCode := $FFFF;              { Your own arbitrary error code }
  754.       exit;
  755.     end;
  756.     FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
  757.     regs.ax := $4403;                { Function $44, subfunction $03 }
  758.     handle  := @cdrom;               { Establish the file handle }
  759.     regs.bx := handle^;
  760.     FillChar(CdCtrlBlock, SizeOf(CdCtrlBlock), 0);
  761.     CdCtrlBlock := $00;              { $00 eject disk; $05 close tray }
  762.     regs.ds := Seg(CdCtrlBlock);     { ds:dx CD-ROM control block }
  763.     regs.dx := Ofs(CdCtrlBlock);
  764.     MsDos (regs);                    { Call interrupt $21 }
  765.     {$I-} Close (cdrom); {$I+}
  766.     ok := regs.flags and FCarry = 0; { Success or not? }
  767.     errCode := regs.ax;              { $01 = invalid function }
  768.   end;                               { $05 = access denied }
  769.   {}                                 { $06 = invalid handle }
  770.   procedure TEST;                    { $0D = invalid data }
  771.   var ok : boolean;
  772.       code : word;
  773.   begin
  774.     EJECT ('K', ok, code);
  775.     if ok then writeln ('Success') else writeln ('Error ', code);
  776.   end;
  777.   {}
  778.   begin
  779.     TEST;
  780.   end.
  781.  
  782. My thanks are due to Miro Wikgren (wikgren@cc.helsinki.fi) who
  783. pointed out that the "handle referencing character device for CD-ROM
  784. driver" must be the name given when the CD-ROM driver is loaded in
  785. CONFIG.SYS and AUTOEXEC.BAT. I could not solve this problem without
  786. that help in comp.lang.pascal.borland. In fact the previous FAQ item
  787. was tackled only after the current FAQ item had been solved first.
  788.  
  789. A slightly different approach to the file handle by Miro
  790.   var cdrom : text; { CD-ROM is a character device }
  791.   handle    : word; { Handle: word, not a pointer }
  792.   :
  793.   handle  := TextRec(cdrom).handle;  { Use TP help for more on this }
  794.   regs.bx := handle;
  795.   :
  796.  
  797. Another solution can be found in
  798.  3427 Mar 15 1996 ftp://garbo.uwasa.fi/pc/turbopas/cdtips01.zip
  799.  cdtips01.zip Eject/Close/Lock/Unlock CD-ROM in TP for Win95, C.Rankin
  800. --------------------------------------------------------------------
  801.  
  802. From ts@uwasa.fi Sat Nov 9 00:01:27 1996
  803. Subject: Detecting ANSI.SYS
  804.  
  805. 87. *****
  806.  Q: How do I find out if the ANSI.SYS driver has been loaded?
  807.  
  808.  A: The source code of the relevant function is given below.
  809. However, this is not necessarily a good solution. First, it requires
  810. at least MS-DOS version 4.0. Second, there are other, compatible
  811. screen drivers like ZANSI.SYS. You probably are more interested if
  812. such a screen driver has been installed rather than if it is
  813. ANSI.SYS in particular. To find out if any compatible screen driver
  814. is operative use ISANSIFN from TSUNTG.TPU from
  815.  ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
  816.  Turbo Pascal 7.0 real mode units for (real:-) programmers
  817.   uses Dos;
  818.   function ANSIOKFN : boolean;
  819.   var regs : registers;
  820.   begin
  821.     if swap(DosVersion) < $0400 then begin
  822.       writeln ('Error: MS-DOS 4+ required');
  823.       ansiokfn := false;
  824.       halt;
  825.     end;
  826.     FillChar (regs, SizeOf(regs), 0);
  827.     regs.ax := $1A00;
  828.     Intr ($2F, regs);
  829.     ansiokfn := regs.al = $FF;
  830.   end; (* ansiokfn *)
  831. --------------------------------------------------------------------
  832.  
  833. From ts@uwasa.fi Sat Nov 9 00:01:28 1996
  834. Subject: TP tutorial and books
  835.  
  836. 88. *****
  837.  Q: Where do I find Turbo Pascal tutorials and/or good textbooks?
  838.  
  839.  A: I'll list some useful sources. The first one (where also this
  840. item comes from) among other things contains a slightly outdated
  841. list of TP textbooks.
  842.  
  843.  ftp://garbo.uwasa.fi/pc/link/tsfaqp.zip
  844.  Common Turbo Pascal Questions and Timo's answers
  845.  
  846.  ftp://garbo.uwasa.fi/pc/turbopas/tptutr11.zip
  847.  Glenn Grotzinger's ascii-text Turbo Pascal Tutor
  848.  
  849.  ftp://garbo.uwasa.fi/pc/turbopas/tpr-book.zip
  850.  Electronic Turbo Pascal Reference freeware book
  851.  
  852.  ftp://garbo.uwasa.fi/pc/doc-net/faqclpb.zip
  853.  comp.lang.pascal.borland newsgroup Mini-FAQ
  854.  
  855. Furthermore, you should see the fine SWAG (SourceWare Archival
  856. Group's) collection of TP sources. Available from the /pc/turbopas
  857. directory at Garbo. For the current references to the SWAG files see
  858. ftp://garbo.uwasa.fi/pc/INDEX.ZIP.
  859.    Yet another useful source can be the Turbo Pascal WWW pages. You
  860. can find some of them by connecting to my WWW home page. Its address
  861. is http://uwasa.fi/~ts. Select my collection of HTTP links and
  862. proceed to the programming section on the link list.
  863. --------------------------------------------------------------------
  864.  
  865. From ts@uwasa.fi Sat Nov 9 00:01:29 1996
  866. Subject: Making an executable
  867.  
  868. 89. *****
  869.  Q: How do I make an executable of my Turbo Pascal source program?
  870.  
  871.  A: This is a typical beginner's frequent question which belies not
  872. having read the manual carefully. You DO have the manual, right? If
  873. you are using Turbo Pascal 7.0 this is explained on page 48 of the
  874. User's Guide in the paragraph "Choosing a destination". Here, in
  875. brief, is what you should do
  876.   Press F10 to go to the main menu (or press alt-C)
  877.   Choose Compile
  878.   Choose Destination Disk  (toggle with enter)
  879. To direct where the executable should go
  880.   Press F10 to go to the main menu (or press alt-O)
  881.   Choose Options
  882.   Choose Directories...
  883.   Edit the item EXE & TPU directory   (the destination directory)
  884.  
  885.  A2: The other alternative is using the TPC i.e. the Command-Line
  886. Compiler. E.g.
  887.    tpc -L myprog.pas
  888. For a quick list of the command-line options type tpc alone. For
  889. more information see your friendly manual.
  890. --------------------------------------------------------------------
  891.  
  892. From ts@uwasa.fi Sat Nov 9 00:01:30 1996
  893. Subject: Last byte of a file
  894.  
  895. 90. *****
  896.  Q: How can I quickly read the last byte of a file?
  897.  
  898.  A: Below is the code for a relevant procedure. It has a number of
  899. instructive details for you to look into. It is easy to expand this
  900. procedure into showing any byte counted from the end by substituting
  901. the 1 in Seek (f, fs-1) to the inverted position, and by taking care
  902. that the position is not outside the file.
  903.   procedure LASTBYTE (fname  : string; var lb : byte);
  904.   var f      : file;       { Use an untyped file designation }
  905.       fmSave : byte;       { To push and pop the FileMode }
  906.       fs     : longint;    { For file size }
  907.   begin
  908.     fmSave := FileMode;    { Push the original FileMode }
  909.     FileMode := 0;         { To enable reading also read-only files }
  910.     Assign (f, fname);
  911.     {$I-} Reset (f, 1); {$I+}     { Open file and set record size to 1 }
  912.     if IOResult <> 0 then begin
  913.       writeln ('Error opening file ', fname);
  914.       halt;
  915.     end;
  916.     fs := FileSize(f);     { Get the size of the file }
  917.     if fs = 0 then begin
  918.       writeln ('Empty file ', fname);
  919.       halt;
  920.     end;
  921.     Seek (f, fs-1);        { Position to the last byte of the file }
  922.     BlockRead (f, lb, 1);  { Read the value of the position into lb }
  923.     Close (f);             { Close the file }
  924.     FileMode := fmSave;    { Pop the original FileMode }
  925.   end; (* lastbyte *)
  926. --------------------------------------------------------------------
  927.  
  928. From ts@uwasa.fi Sat Nov 9 00:01:31 1996
  929. Subject: Leap year
  930.  
  931. 91. *****
  932.  Q: Is 2000 a leap year? What is the leap year algorithm?
  933.  
  934.  A: With the approaching turn of the century this question is
  935. becoming more and more common. Here is the algorithm in Turbo
  936. Pascal.
  937.  function ISLEAP (y : integer) : boolean;
  938.  begin
  939.    isleap := (y mod 4 = 0) and not ((y mod 100 = 0) and not (y mod 400 = 0));
  940.  end;  (* isleap *)
  941. My thanks are due to Dr. John Stockton and Associate Professor Seppo
  942. Pynnonen for confirming the result. In fact it was who John
  943. suggested adding this question to the FAQ.
  944.    There are several equivalent formulations achieving the same
  945. result. Also nested multi-line if statments could be used. The
  946. boolean statements are much more concise, even if not very easy to
  947. construct.
  948.    If you are interested calendar related questions here is one
  949. useful URL reference: ftp://login.dknet.dk/pub/ct/calendar.faq
  950. "Frequentely asked questions about calendars" by Claus Tondering.
  951. --------------------------------------------------------------------
  952.  
  953. From ts@uwasa.fi Sat Nov 9 00:01:32 1996
  954. Subject: Week number
  955.  
  956. 92. *****
  957.  Q: Does anybody have a program that gives the week number?
  958.  
  959.  A1: The first part of the answer comes without source code just
  960. with a pointer to a TPU including a week number algorithm. There is
  961. a function
  962.  "WEEKNRFN Returns the week number for a given date"
  963. in the TSUNTE.TPU unit in my
  964.  ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip
  965.  Turbo Pascal 7.0 real mode units for (real:-) programmers.
  966. (The unit collection is also available for earlier TP versions.)
  967.  
  968.  A2: Below is with permissions the weeknumber source code by Anders
  969. Roar Nielsen aroni@night.ping.dk posted to the Usenet newsgroup
  970. news:comp.lang.pascal.borland by Mark Cole mcole@spuddy.mew.co.uk.
  971. The DayNumber function has been streamlined by Dr. John Stockton.
  972. Only apply on the Gregorian calendar is covered. I do not know if
  973. weekday numbering is internationally standardized or if it is rather
  974. based on national practices.
  975.  
  976. function FirstThursday (Year: Integer) : Integer;
  977.   begin
  978.     FirstThursday := 7 - (1 + (Year-1600) + (Year-1597) div 4
  979.     - (Year-1501) div 100 + (Year-1201) div 400) mod 7;
  980.   end;
  981.  
  982. function DayNumber (Day, Month, Year : Integer) : Integer;
  983.   const
  984.     DaysBeforeMonth : array [1..12] of Integer =
  985.                    (0,31,59,90,120,151,181,212,243,273,304,334);
  986.   begin
  987.     DayNumber := DaysBeforeMonth[Month] + Day + Ord( (Month > 2) and
  988.       (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)) ) ;
  989.   end;
  990.  
  991. function WeekNumber (Day, Month, Year : Integer ) : Integer;
  992.   begin
  993.     if (Month = 1) and (Day < FirstThursday(Year)-3) then
  994.       WeekNumber := WeekNumber(31,12,Pred(Year))
  995.     else
  996.       if (Month = 12) and (Day > FirstThursday(Succ(Year))+27) then
  997.       WeekNumber := 1
  998.     else
  999.       WeekNumber := (DayNumber(Day,Month,Year)-FirstThursday(Year)+10) div 7;
  1000.   end;
  1001. --------------------------------------------------------------------
  1002.  
  1003. From ts@uwasa.fi Sat Nov 9 00:01:33 1996
  1004. Subject: OutText, integers and reals
  1005.  
  1006. 93. *****
  1007.  Q: How can I use OutText to write numbers in the graphics mode?
  1008.  
  1009.  A: OutText is the procedure to use for output in the graphics mode.
  1010. The syntax of the procedure is OutText(TextString: string). You'll
  1011. first have to convert a number into a string before you can output
  1012. it with OutText. The example below shows how it can be done when the
  1013. users wishes to output the integer value value of 12 and the result
  1014. of 4/7 as a real with a suitable formatting. Generalization from
  1015. thereon should be easy.
  1016.   uses Crt, Graph;
  1017.   var grDriver : integer;
  1018.       grMode   : integer;
  1019.       ErrCode  : integer;
  1020.   const CharSize : integer = 2;
  1021.   {}
  1022.   function INT2STR (x : integer; ff : byte) : string;
  1023.   var s : string;
  1024.   begin
  1025.     Str (x : ff, s);
  1026.     int2str := s;
  1027.   end;
  1028.   {}
  1029.   function REAL2STR (x : real; ff, dd : byte) : string;
  1030.   var s : string;
  1031.   begin
  1032.     Str (x : ff : dd, s);
  1033.     real2str := s;
  1034.   end;
  1035.   {}
  1036.   begin
  1037.     grDriver := Detect;
  1038.     InitGraph (grDriver, grMode, ' ');
  1039.     ErrCode := GraphResult;
  1040.     if ErrCode <> grOk then begin
  1041.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  1042.     SetColor (LightCyan);
  1043.     SetBkColor (Black);
  1044.     SetTextStyle(DefaultFont, HorizDir, CharSize);
  1045.     {}
  1046.     {... this is the example's key line ...}
  1047.     OutText ('The values are: ' + INT2STR(12,2) + REAL2STR(4/7,10,3));
  1048.     {}
  1049.     MoveTo (0, 10*CharSize);
  1050.     OutText ('Press any key');
  1051.     repeat until KeyPressed;
  1052.     RestoreCrtMode;
  1053.     CloseGraph;
  1054.   end.
  1055. Naturally, the 12 in INT2STR(12,2) could as well be a variable
  1056. containing the value. Ditto for REAL2STR(4/7,10,3).
  1057. --------------------------------------------------------------------
  1058.  
  1059. From ts@uwasa.fi Sat Nov 9 00:01:34 1996
  1060. Subject: Ctr and output redirection
  1061.  
  1062. 94. *****
  1063.  Q: How can I redirect output to file if I use the Crt unit?
  1064.  
  1065.  A: First example:
  1066.   uses Crt;
  1067.   begin
  1068.     writeln ('This output cannot be redireted');
  1069.     assign (output, '');   { standard output }
  1070.     rewrite (output);
  1071.     writeln ('This output can be redirected');
  1072.   end.
  1073.  
  1074. Second example:
  1075.   uses Crt;
  1076.   var f: Text;
  1077.   begin
  1078.     Assign (f, '');
  1079.     Rewrite (f);
  1080.     Writeln (f, 'This output can be redirected');
  1081.     Close (f);
  1082.     AssignCrt (f);
  1083.     Rewrite (f);
  1084.     Writeln (f, 'This output cannot be redirected');
  1085.     Close(f);
  1086.   end.
  1087. --------------------------------------------------------------------
  1088.  
  1089. From ts@uwasa.fi Sat Nov 9 00:01:35 1996
  1090. Subject: In text or graphics mode
  1091.  
  1092. 95. *****
  1093.  Q: How to write a function to return true if I am in graphics mode?
  1094.  
  1095.  A: The ISGRFN in the example below returns true if the program
  1096. currently runs in the graphics mode and false in the text mode. For
  1097. more information see Ralf Brown's interrupt list part INTERRUP.A for
  1098. interrupt $10 functions $00 and $0F.
  1099.  
  1100.   uses Dos, Crt, Graph;
  1101.  
  1102.   (* The function to detect whether in video or text mode *)
  1103.   function ISGRFN : boolean;
  1104.   var regs : registers;
  1105.   begin
  1106.     FillChar (regs, SizeOf(regs), 0); { Just to make sure }
  1107.     regs.ah := $0F;                   { Function $0F gets video mode }
  1108.     Intr ($10, regs);                 { Call the video interrupt }
  1109.     case regs.al of
  1110.       $00,$01,$02,$03,$07 : isgrfn := false;  { is in text mode }
  1111.       else isgrfn := true;                    { is in graphics mode }
  1112.     end; {case}
  1113.   end;  (* isgrfn *)
  1114.  
  1115.   (* A procedure to turn the default graphics on *)
  1116.   procedure GRAPHON;
  1117.   var grDriver : integer;
  1118.       grMode   : integer;
  1119.       ErrCode  : integer;
  1120.   begin
  1121.     grDriver := Detect;
  1122.     InitGraph (grDriver, grMode, ' ');
  1123.     ErrCode := GraphResult;
  1124.     if ErrCode <> grOk then begin
  1125.       Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
  1126.     ClearDevice;
  1127.   end;  (* graphon *)
  1128.  
  1129.   (* Test in the text mode *)
  1130.   procedure TEST1;
  1131.   begin
  1132.     if ISGRFN then
  1133.       writeln ('In graphics mode')
  1134.       else
  1135.       writeln ('In text mode');
  1136.     writeln ('Press any key');
  1137.     repeat until KeyPressed;        { allow seeing the result }
  1138.     while KeyPressed do ReadKey;    { clear typeahead buffer }
  1139.   end;  (* test1 *)
  1140.  
  1141.   (* Test in the graphics mode *)
  1142.   procedure TEST2;
  1143.   begin
  1144.     GRAPHON;
  1145.     SetColor (Yellow);
  1146.     SetBkColor (Black);
  1147.     SetTextStyle (DefaultFont, HorizDir, 2);
  1148.     if ISGRFN then
  1149.       OutTextXY (100, 20, 'In graphics mode')
  1150.       else
  1151.       OutTextXY (100, 20, 'In text mode');
  1152.     OutTextXY (100, 50, 'Press any key');
  1153.     repeat until KeyPressed;               { allow seeing the result }
  1154.     while KeyPressed do ReadKey;           { clear typeahead buffer }
  1155.     RestoreCrtMode;
  1156.     CloseGraph;
  1157.   end;  (* test2 *)
  1158.  
  1159.   (* Main program *)
  1160.   begin
  1161.     TEST1;
  1162.     TEST2;
  1163.   end.
  1164. --------------------------------------------------------------------
  1165.  
  1166. From ts@uwasa.fi Sat Nov 9 00:01:36 1996
  1167. Subject: Lost my graph.tpu
  1168.  
  1169. 96. *****
  1170.  Q: My graph.tpu got corrupted. Someone please email me a new copy.
  1171.  
  1172.  A: Then you should restore the unit from the Turbo Pascal
  1173. installation disks that came with the package when you bought it. If
  1174. you have TP 7.0, the GRAPH.TPU - Borland Graphics Interface (BGI)
  1175. Graph unit - is located on the installation disk #4.
  1176.    This plea is being often presented on the Usenet Turbo Pascal
  1177. newsgroups. It coincides with reports of an incomplete pirate Turbo
  1178. Pascal copy in circulation. This fact explains why so often the user
  1179. has "lost" the installation disk ("my dog ate it", "my girl/
  1180. boyfriend borrowed/ate it", "I misplaced it in the student rally",
  1181. "I poured coffee/coke/ooze on it", "it was abducted by the aliens").
  1182.   There is no reason why we should to compound the piracy by
  1183. consenting to these requests. In the (unlikely?) case that the
  1184. dilemma is honest, the user should contact his/her friendly vendor
  1185. to replace his/her damaged installation disk.
  1186. --------------------------------------------------------------------
  1187.  
  1188. From ts@uwasa.fi Sat Nov 9 00:01:37 1996
  1189. Subject: Numeric input errors
  1190.  
  1191. 97. *****
  1192.  Q: How can I avoid run-time errors in numeric input using readln?
  1193.  
  1194.  A: The answer to this common question is to read the user's input
  1195. into a string first instead directly into the numeric variable(s).
  1196. As so often, the idea is best presented by a simple source code
  1197. example.
  1198.   var x : real;
  1199.       s, tx : string;
  1200.       k : integer;
  1201.   begin
  1202.     repeat
  1203.       tx := 'Give a number: ';
  1204.       write (tx);
  1205.       readln (s);
  1206.       Val (s, x, k);
  1207.       if k > 0 then writeln ('^':k+length(tx), #7);
  1208.     until k = 0;
  1209.   end.
  1210. --------------------------------------------------------------------
  1211.  
  1212. From ts@uwasa.fi Sat Nov 9 00:01:38 1996
  1213. Subject: Limited input
  1214.  
  1215. 98. *****
  1216.  Q: How can I limit the user's readln input to e.g. 3 characters?
  1217.  
  1218.  A: Of course you could use the ordinary readln and check
  1219. afterwards, but if you wish to limit the length already at the time
  1220. the user types the input then you have to write an input routine of
  1221. your own. One way of doing that is to build a ReadKey loop with
  1222. editing capabilities. See the item "Turning off the input echo" in
  1223. this same FAQ for the basics.
  1224.    However, there is a really neat solution using the MS-DOS
  1225. interrupt $21 buffered keyboard input function $0A. The solution was
  1226. posted by Osmo Ronkanen ronkanen@cc.helsinki.fi. It is given below.
  1227. I have made some minor changes in the original code.
  1228.   uses Dos;
  1229.   {}
  1230.   Procedure BufferedInput (var st : string; max : byte);
  1231.   var regs : registers;
  1232.       buffer : record
  1233.                  maxlen : byte;
  1234.                  stb    : string;
  1235.                end;
  1236.   begin
  1237.     Buffer.Maxlen := max+1;     { allow for the enter at the end }
  1238.     regs.ds := Seg (buffer);    { buffer address }
  1239.     regs.dx := Ofs (buffer);
  1240.     regs.ah := $0A;
  1241.     MsDos (regs);
  1242.     Move (Buffer.stb[0], st[0], Length(Buffer.stb)+1);
  1243.     Writeln;
  1244.   end;
  1245.   {}
  1246.   procedure TEST;
  1247.   var s : string;
  1248.   begin
  1249.     Write ('Give your input: ');
  1250.     BufferedInput (s, 3);
  1251.     Writeln (s);
  1252.   end;
  1253.   {}
  1254.   begin
  1255.     TEST;
  1256.   end.
  1257. --------------------------------------------------------------------
  1258.  
  1259. From ts@uwasa.fi Sat Nov 9 00:01:39 1996
  1260. Subject: Deleting a file
  1261.  
  1262. 99. *****
  1263.  Q: Can you tell a beginner how to delete files with Turbo Pascal?
  1264.  
  1265.  A: A simple example code is give below
  1266.   const filename = 'test.txt';
  1267.   var f : file;
  1268.   begin
  1269.     Assign (f, filename);
  1270.     {$I-} Erase(f); {$I+}
  1271.     if IoResult = 0 then
  1272.       writeln ('File ', filename, ' deleted')
  1273.     else
  1274.       writeln ('File ', filename, ' not found or protected');
  1275.   end.
  1276. There is nothing wrong with asking, but the answer would have been
  1277. readily available on your manuals or even by using Turbo Pascal
  1278. IDE's help function. In fact, in Turbo Pascal 7.0 you can even get
  1279. an example by writing 'erase' in your program, moving the cursor on
  1280. the word and then by pressing ctrl-F1.
  1281.    While we are at it, let consider slightly more advanced issues.
  1282. Let's say you need to delete a read-only file. The above code will
  1283. not delete such special files. The first thing you'll find useful to
  1284. be able to do is to test if a file exists and then if it is a
  1285. read-only file. Here are the relevant functions.
  1286.   (* Does a file exist, detects also read-only, hidden and system files *)
  1287.   function FEXIST (filename : string) : boolean;
  1288.   var f : SearchRec;
  1289.   begin
  1290.     fexist := false;
  1291.     FindFirst (filename, AnyFile, f);
  1292.     if DosError = 0 then
  1293.       if (f.attr and Directory = 0) and (f.attr and VolumeId = 0) then
  1294.         fexist := true;
  1295.   end;  (* fexist *)
  1296.   {}
  1297.   (* Is the file a read-only file *)
  1298.   function ISRDONLY (filename : string) : boolean;
  1299.   var f : SearchRec;
  1300.   begin
  1301.     isrdonly := false;
  1302.     FindFirst (filename, AnyFile, f);
  1303.     if DosError = 0 then
  1304.       if (f.attr and Directory = 0) and (f.attr and VolumeId = 0) and
  1305.          (f.attr and ReadOnly > 0) then
  1306.         isrdonly := true;
  1307.   end;  (* isrdonly *)
  1308. This, incidentally is not the only way to test. Below is another
  1309. example, this time showing how to detect if a file is a hidden file.
  1310.   (* Is the file a hidden file, a slightly different method *)
  1311.   function ISHIDDEN (filename : string) : boolean;
  1312.   var f : file;
  1313.       attr : word;
  1314.   begin
  1315.     Assign (f, filename);
  1316.     GetFAttr (f, attr);
  1317.     if DosError = 0 then
  1318.       ishidden := attr and Hidden > 0
  1319.     else
  1320.       ishidden := false;
  1321.   end;  (* ishidden *)
  1322. Next, if tests showed that the file exists and that it is a
  1323. read-only file, you need to convert the read-only file back into an
  1324. ordinary file. Here is the routine.
  1325.   (* Convert a read-only file into a normal file *)
  1326.   procedure RDNORMAL (filename : string);
  1327.   var f : file;
  1328.       attr : word;
  1329.   begin
  1330.     Assign (f, filename);
  1331.     GetFAttr (f, attr);
  1332.     SetFAttr (f, attr and not readonly);
  1333.     if DosError = 0 then
  1334.       writeln ('Removed the read-only attribute from ', filename)
  1335.     else
  1336.       writeln ('Could not convert the read-only file ', filename);
  1337.   end;
  1338. How to put this all together into a program that erases both normal
  1339. and read-only files is left as an exercise to the reader. All the
  1340. essential constituents have now been given.
  1341. --------------------------------------------------------------------
  1342.  
  1343. From ts@uwasa.fi Sat Nov 9 00:01:40 1996
  1344. Subject: Shift operators shl and shr
  1345.  
  1346. 100. *****
  1347.  Q: Could you please explain shl and shr operators to a beginner?
  1348.  
  1349.  A: Shl and shr perform bit operations on the integer type. They are
  1350. logical operators. In terms of a binary expression the former shifts
  1351. the bits of an integer to the left while shr shifts them to the
  1352. right.
  1353.    To illustrate, think of the variable as a binary number instead
  1354. of a decimal. Consider for example
  1355.   var x : word;
  1356.   x := 219;
  1357. In binary presentation it is
  1358.   The word                  0000 0000 1101 1011
  1359.   Position in the word      FEDC BA98 7654 3210
  1360. If you perform a shift to the left by, for example by 2 steps,
  1361. you'll have
  1362.   The word                  0000 0011 0110 1100
  1363.   Position in the word      FEDC BA98 7654 3210
  1364. which in decimal terms is 876. In decimal TP notation this amounts
  1365. to the operation
  1366.   var b : word;
  1367.   b := x shl 2;
  1368. The value of b will be 876. Likewise, you can perform a shift to the
  1369. right. For example
  1370.   b := x shr 1;
  1371. will be 109 because then you'll have
  1372.   The word                  0000 0000 0110 1101
  1373.   Position in the word      FEDC BA98 7654 3210
  1374. A question when and why this operation is needed has too varied an
  1375. answer to try to give it. However, there are several items in this
  1376. FAQ that show examples of factual usage of these operators in TP
  1377. programming tasks.
  1378. --------------------------------------------------------------------
  1379.  
  1380.